{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

module BNFC.Options
  ( Mode(..), Target(..), Backend
  , parseMode, usage, help
  , SharedOptions(..)
  , defaultOptions, isDefault, printOptions
  , AlexVersion(..), HappyMode(..), OCamlParser(..), JavaLexerParser(..)
  , RecordPositions(..), TokenText(..)
  , translateOldOptions
  )
  where

import qualified Control.Monad as Ctrl
import Control.Monad.Writer (WriterT, runWriterT, tell)
import Control.Monad.Except (MonadError(..))

import qualified Data.Map  as Map
import qualified Data.List as List
import Data.Maybe      (fromMaybe, maybeToList)
import Data.Version    (showVersion )

import System.Console.GetOpt
import System.FilePath (takeBaseName)

import Text.Printf     (printf)

import Paths_BNFC      (version)
import BNFC.CF         (CF)
import BNFC.Utils      (unless)

-- ~~~ Option data structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- | To decouple the option parsing from the execution of the program,
-- we introduce a data structure that holds the result of the
-- parsing of the arguments.
data Mode
    -- An error has been made by the user
    -- e.g. invalid argument/combination of arguments
    = UsageError String
    -- Basic modes: print some info and exits
    | Help | Version
    -- Normal mode, specifying the back end to use,
    -- the option record to be passed to the backend
    -- and the path of the input grammar file
    | Target SharedOptions FilePath
  deriving (Eq,Show,Ord)

-- | Target languages
data Target = TargetC | TargetCpp | TargetCppNoStl | TargetCSharp
            | TargetHaskell | TargetHaskellGadt | TargetLatex
            | TargetJava | TargetOCaml | TargetProfile | TargetPygments
            | TargetCheck
  deriving (Eq, Bounded, Enum, Ord)

-- | List of Haskell target.
haskellTargets :: [Target]
haskellTargets = [ TargetHaskell, TargetHaskellGadt, TargetProfile ]

instance Show Target where
  show TargetC            = "C"
  show TargetCpp          = "C++"
  show TargetCppNoStl     = "C++ (without STL)"
  show TargetCSharp       = "C#"
  show TargetHaskell      = "Haskell"
  show TargetHaskellGadt  = "Haskell (with GADT)"
  show TargetLatex        = "Latex"
  show TargetJava         = "Java"
  show TargetOCaml        = "OCaml"
  show TargetProfile      = "Haskell (with permutation profiles)"
  show TargetPygments     = "Pygments"
  show TargetCheck        = "Check LBNF file"

-- | Which version of Alex is targeted?
data AlexVersion = Alex1 | Alex2 | Alex3
  deriving (Show,Eq,Ord,Bounded,Enum)

-- | Happy modes
data HappyMode = Standard | GLR
  deriving (Eq,Show,Bounded,Enum,Ord)

-- | Which parser generator for ocaml?
data OCamlParser = OCamlYacc | Menhir
    deriving (Eq,Show,Ord)

-- | Which Java backend?
data JavaLexerParser = JLexCup | JFlexCup | Antlr4
    deriving (Eq,Show,Ord)

data RecordPositions = RecordPositions | NoRecordPositions
    deriving (Eq,Show,Ord)

-- | How to represent token content in the Haskell backend?

data TokenText
  = StringToken      -- ^ Represent strings as @String@.
  | ByteStringToken  -- ^ Represent strings as @ByteString@.
  | TextToken        -- ^ Represent strings as @Data.Text@.
  deriving (Eq, Ord, Show)

-- | This is the option record that is passed to the different backends.
data SharedOptions = Options
  --- Option shared by at least 2 backends
  { lbnfFile    :: FilePath        -- ^ The input file BNFC processes.
  , lang        :: String          -- ^ The language we generate: the basename of 'lbnfFile'.
  , outDir      :: FilePath        -- ^ Target directory for generated files.
  , force       :: Bool            -- ^ Ignore errors as much as possible?
  , target      :: Target          -- ^ E.g. @--haskell@.
  , make        :: Maybe String    -- ^ The name of the Makefile to generate or Nothing for no Makefile.
  , inPackage   :: Maybe String    -- ^ The hierarchical package to put the modules in, or Nothing.
  , linenumbers :: RecordPositions -- ^ Add and set line_number field for syntax classes
  --- Haskell specific:
  , inDir         :: Bool        -- ^ Option @-d@.
  , functor       :: Bool        -- ^ Option @--functor@.  Make AST functorial?
  , generic       :: Bool        -- ^ Option @--generic@.  Derive Data, Generic, Typeable?
  , alexMode      :: AlexVersion -- ^ Options @--alex@.
  , shareStrings  :: Bool        -- ^ Option @--sharestrings@.
  , tokenText     :: TokenText   -- ^ Options @--bytestrings@, @--string-token@, and @--text-token@.
  , glr           :: HappyMode   -- ^ Happy option @--glr@.
  , xml           :: Int         -- ^ Options @--xml@, generate DTD and XML printers.
  , cnf           :: Bool        -- ^ Option @--cnf@. Generate CNF-like tables?
  , agda          :: Bool        -- ^ Option @--agda@. Create bindings for Agda?
  --- OCaml specific
  , ocamlParser   :: OCamlParser -- ^ Option @--menhir@ to switch to @Menhir@.
  --- Java specific
  , javaLexerParser :: JavaLexerParser
  --- C# specific
  , visualStudio  :: Bool        -- ^ Generate Visual Studio solution/project files.
  , wcf           :: Bool        -- ^ Windows Communication Foundation.
  } deriving (Eq, Ord, Show)

-- We take this opportunity to define the type of the backend functions.
type Backend = SharedOptions  -- ^ Options
            -> CF             -- ^ Grammar
            -> IO ()

defaultOptions :: SharedOptions
defaultOptions = Options
  { lbnfFile        = error "lbnfFile not set"
  , lang            = error "lang not set"
  , outDir          = "."
  , force           = False
  , target          = TargetHaskell
  , make            = Nothing
  , inPackage       = Nothing
  , linenumbers     = NoRecordPositions
  -- Haskell specific
  , inDir           = False
  , functor         = False
  , generic         = False
  , alexMode        = Alex3
  , shareStrings    = False
  , tokenText       = StringToken
  , glr             = Standard
  , xml             = 0
  , cnf             = False
  , agda            = False
  -- OCaml specific
  , ocamlParser     = OCamlYacc
  -- Java specific
  , javaLexerParser = JLexCup
  -- C# specific
  , visualStudio    = False
  , wcf             = False
  }

-- | Check whether an option is unchanged from the default.
isDefault :: (Eq a)
  => (SharedOptions -> a)  -- ^ Option field name.
  -> SharedOptions         -- ^ Options.
  -> Bool
isDefault flag opts = flag opts == flag defaultOptions

-- | Return something in case option differs from default.
unlessDefault :: (Monoid m, Eq a)
  => (SharedOptions -> a)  -- ^ Option field name.
  -> SharedOptions         -- ^ Options.
  -> (a -> m)              -- ^ Action in case option differs from standard.
  -> m
unlessDefault flag opts f = unless (o == flag defaultOptions) $ f o
  where o = flag opts

-- -- | Return something in case option is unchanged from default.
-- whenDefault :: (Monoid m, Eq a)
--   => (SharedOptions -> a)  -- ^ Option field name.
--   -> SharedOptions         -- ^ Options.
--   -> m                     -- ^ Action in case option is unchanged from standard.
--   -> m
-- whenDefault flag opts m = when (o == flag defaultOptions) m
--   where o = flag opts

-- | Print options as input to BNFC.
--
-- @unwords [ "bnfc", printOptions opts ]@ should call bnfc with the same options
-- as the current instance.
--
printOptions :: SharedOptions -> String
printOptions opts = unwords . concat $
  [ [ printTargetOption tgt ]
  -- General and shared options:
  , unlessDefault outDir opts $ \ o -> [ "--outputdir=" ++ o ]
  , [ "--makefile=" ++ m  | m <- maybeToList $ make opts        ]
  , [ "-p " ++ p          | p <- maybeToList $ inPackage opts   ]
  , unlessDefault linenumbers opts $ const [ "-l" ]
  -- Haskell options:
  , [ "-d"                | inDir opts                          ]
  , [ "--functor"         | functor opts                        ]
  , [ "--generic"         | generic opts                        ]
  , unlessDefault alexMode opts $ \ o -> [ printAlexOption o ]
  , [ "--sharestrings"    | shareStrings opts                   ]
  , [ "--bytestrings"     | tokenText opts == ByteStringToken   ]
  , [ "--text-token"      | tokenText opts == TextToken, not (agda opts) ]  -- default for --agda
  , [ "--string-token"    | tokenText opts == StringToken, agda opts ]      -- default unless --agda
  , [ "--glr"             | glr opts == GLR                     ]
  , [ "--xml"             | xml opts == 1                       ]
  , [ "--xmlt"            | xml opts == 2                       ]
  , [ "--cnf"             | cnf opts                            ]
  , [ "--agda"            | agda opts                           ]
  -- C# options:
  , [ "--vs"              | visualStudio opts                   ]
  , [ "--wfc"             | wcf opts                            ]
  -- Java options:
  , unlessDefault javaLexerParser opts $ \ o -> [ printJavaLexerParserOption o ]
  -- Java options:
  , unlessDefault ocamlParser opts $ \ o -> [ printOCamlParserOption o ]
  -- Grammar file:
  , [ lbnfFile opts ]
  ]
  where
  tgt = target opts
  -- haskell = tgt `elem` haskellTargets

-- | Print target as an option to BNFC.
printTargetOption :: Target -> String
printTargetOption = ("--" ++) . \case
  TargetC           -> "c"
  TargetCpp         -> "cpp"
  TargetCppNoStl    -> "cpp-nostl"
  TargetCSharp      -> "csharp"
  TargetHaskell     -> "haskell"
  TargetHaskellGadt -> "haskell-gadt"
  TargetLatex       -> "latex"
  TargetJava        -> "java"
  TargetOCaml       -> "ocaml"
  TargetProfile     -> "profile"
  TargetPygments    -> "pygments"
  TargetCheck       -> "check"

printAlexOption :: AlexVersion -> String
printAlexOption = ("--" ++) . \case
  Alex1 -> "alex1"
  Alex2 -> "alex2"
  Alex3 -> "alex3"

printJavaLexerParserOption :: JavaLexerParser -> String
printJavaLexerParserOption = ("--" ++) . \case
  JLexCup  -> "jlex"
  JFlexCup -> "jflex"
  Antlr4   -> "antlr4"

printOCamlParserOption :: OCamlParser -> String
printOCamlParserOption = ("--" ++) . \case
  OCamlYacc -> "yacc"
  Menhir    -> "menhir"

-- ~~~ Option definition ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- This defines bnfc's "global" options, like --help
globalOptions :: [ OptDescr Mode ]
globalOptions = [
  Option [] ["help"]                      (NoArg Help)         "show help",
  Option [] ["version","numeric-version"] (NoArg Version)      "show version number"]

-- | Options for the target languages
-- targetOptions :: [ OptDescr Target ]
targetOptions :: [ OptDescr (SharedOptions -> SharedOptions)]
targetOptions =
  [ Option "" ["java"]          (NoArg (\o -> o {target = TargetJava}))
    "Output Java code [default: for use with JLex and CUP]"
  , Option "" ["java-antlr"]    (NoArg (\ o -> o{ target = TargetJava, javaLexerParser = Antlr4 }))
    "Output Java code for use with ANTLR (short for --java --antlr)"
  , Option "" ["haskell"]       (NoArg (\o -> o {target = TargetHaskell}))
    "Output Haskell code for use with Alex and Happy (default)"
  , Option "" ["haskell-gadt"]  (NoArg (\o -> o {target = TargetHaskellGadt}))
    "Output Haskell code which uses GADTs"
  , Option "" ["latex"]         (NoArg (\o -> o {target = TargetLatex}))
    "Output LaTeX code to generate a PDF description of the language"
  , Option "" ["c"]             (NoArg (\o -> o {target = TargetC}))
    "Output C code for use with FLex and Bison"
  , Option "" ["cpp"]           (NoArg (\o -> o {target = TargetCpp}))
    "Output C++ code for use with FLex and Bison"
  , Option "" ["cpp-nostl"]     (NoArg (\o -> o {target = TargetCppNoStl}))
    "Output C++ code (without STL) for use with FLex and Bison"
  , Option "" ["csharp"]        (NoArg (\o -> o {target = TargetCSharp}))
    "Output C# code for use with GPLEX and GPPG [deprecated]"
  , Option "" ["ocaml"]         (NoArg (\o -> o {target = TargetOCaml}))
    "Output OCaml code for use with ocamllex and ocamlyacc"
  , Option "" ["ocaml-menhir"]  (NoArg (\ o -> o{ target = TargetOCaml, ocamlParser = Menhir }))
    "Output OCaml code for use with ocamllex and menhir (short for --ocaml --menhir)"
  , Option "" ["profile"]       (NoArg (\o -> o {target = TargetProfile}))
    "Output Haskell code for rules with permutation profiles [deprecated]"
  , Option "" ["pygments"]      (NoArg (\o -> o {target = TargetPygments}))
    "Output a Python lexer for Pygments"
  , Option "" ["check"]         (NoArg (\ o -> o{target = TargetCheck }))
    "No output. Just check input LBNF file"
  ]

-- | A list of the options and for each of them, the target language
-- they apply to.
specificOptions :: [(OptDescr (SharedOptions -> SharedOptions), [Target])]
specificOptions =
  [ ( Option ['l'] ["line-numbers"] (NoArg (\o -> o {linenumbers = RecordPositions})) $ unlines
        [ "Add and set line_number field for all syntax classes"
        , "(Note: Java requires cup version 0.11b-2014-06-11 or greater.)"
        ]
    , [TargetC, TargetCpp, TargetJava] )
  , ( Option ['p'] ["name-space"]
      (ReqArg (\n o -> o {inPackage = Just n}) "NAMESPACE")
          "Prepend NAMESPACE to the package/module name"
    , [TargetCpp, TargetCSharp, TargetJava] ++ haskellTargets)
  -- Java backend:
  , ( Option [] ["jlex"  ] (NoArg (\o -> o {javaLexerParser = JLexCup}))
          "Lex with JLex, parse with CUP (default)"
    , [TargetJava] )
  , ( Option [] ["jflex" ] (NoArg (\o -> o {javaLexerParser = JFlexCup}))
          "Lex with JFlex, parse with CUP"
    , [TargetJava] )
  , ( Option [] ["antlr4"] (NoArg (\o -> o {javaLexerParser = Antlr4}))
          "Lex and parse with antlr4"
    , [TargetJava] )
  -- OCaml backend:
  , ( Option [] ["yacc"  ] (NoArg (\ o -> o { ocamlParser = OCamlYacc }))
          "Generate parser with ocamlyacc (default)"
    , [TargetOCaml] )
  , ( Option [] ["menhir"] (NoArg (\ o -> o { ocamlParser = Menhir }))
          "Generate parser with menhir"
    , [TargetOCaml] )
  -- C++ backend:
  , ( Option [] ["vs"] (NoArg (\o -> o {visualStudio = True}))
          "Generate Visual Studio solution/project files"
    , [TargetCSharp] )
  , ( Option [] ["wcf"] (NoArg (\o -> o {wcf = True}))
          "Add support for Windows Communication Foundation,\n by marking abstract syntax classes as DataContracts"
    , [TargetCSharp] )
  -- Haskell backends:
  , ( Option ['d'] [] (NoArg (\o -> o {inDir = True}))
          "Put Haskell code in modules LANG.* instead of LANG* (recommended)"
    , haskellTargets )
  , ( Option []    ["alex1"] (NoArg (\o -> o {alexMode = Alex1}))
          "Use Alex 1.1 as Haskell lexer tool [deprecated]"
    , haskellTargets )
  , ( Option []    ["alex2"] (NoArg (\o -> o {alexMode = Alex2}))
          "Use Alex 2 as Haskell lexer tool [deprecated]"
    , haskellTargets )
  , ( Option []    ["alex3"] (NoArg (\o -> o {alexMode = Alex3}))
          "Use Alex 3 as Haskell lexer tool (default)"
    , haskellTargets )
  , ( Option []    ["sharestrings"] (NoArg (\o -> o {shareStrings = True}))
          "Use string sharing in Alex 2 lexer [deprecated]"
    , haskellTargets )
  , ( Option []    ["bytestrings"] (NoArg (\o -> o { tokenText = ByteStringToken }))
          "Use ByteString in Alex lexer"
    , haskellTargets )
  , ( Option []    ["text-token"] (NoArg (\o -> o { tokenText = TextToken }))
          "Use Text in Alex lexer"
          -- "Use Text in Alex lexer (default for --agda)"
    , haskellTargets )
  , ( Option []    ["string-token"] (NoArg (\o -> o { tokenText = StringToken }))
          "Use String in Alex lexer (default)"
    , haskellTargets )
  , ( Option []    ["glr"] (NoArg (\o -> o {glr = GLR}))
          "Output Happy GLR parser [deprecated]"
    , haskellTargets )
  , ( Option []    ["functor"] (NoArg (\o -> o {functor = True}))
          "Make the AST a functor and use it to store the position of the nodes"
    , haskellTargets )  -- TODO: ok with --profile?
  , ( Option []    ["generic"] (NoArg (\o -> o {generic = True}))
          "Derive Data, Generic, and Typeable instances for AST types"
    , haskellTargets )  -- TODO: ok with --profile?
  , ( Option []    ["xml"] (NoArg (\o -> o {xml = 1}))
          "Also generate a DTD and an XML printer"
    , haskellTargets )
  , ( Option []    ["xmlt"] (NoArg (\o -> o {xml = 2}))
          "DTD and an XML printer, another encoding"
    , haskellTargets )
  -- CNF and Agda do not support the GADT syntax
  , ( Option []    ["cnf"] (NoArg (\o -> o {cnf = True}))
          "Use the CNF parser instead of happy"
    , [TargetHaskell] )
  , ( Option []    ["agda"] (NoArg (\o -> o { agda = True, tokenText = TextToken }))
          "Also generate Agda bindings for the abstract syntax"
    , [TargetHaskell] )
  ]

-- | The list of specific options for a target.
specificOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
specificOptions' t = map fst $ filter (elem t . snd) specificOptions

commonOptions :: [OptDescr (SharedOptions -> SharedOptions)]
commonOptions =
  [ Option "m" ["makefile"] (OptArg (setMakefile . fromMaybe "Makefile") "MAKEFILE")
      "generate Makefile"
  , Option "o" ["outputdir"] (ReqArg (\n o -> o {outDir = n}) "DIR")
      "Redirects all generated files into DIR"
  , Option ""  ["force"]     (NoArg (\ o -> o { force = True }))
      "Ignore errors in the grammar (may produce ill-formed output or crash)"
  ]
  where setMakefile mf o = o { make = Just mf }

allOptions :: [OptDescr (SharedOptions -> SharedOptions)]
allOptions = targetOptions ++ commonOptions ++ map fst specificOptions

-- | All target options and all specific options for a given target.
allOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
allOptions' t = targetOptions ++ commonOptions ++ specificOptions' t

-- ~~~ Help strings ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

title :: [String]
title =
  [ "The BNF Converter, " ++ showVersion version ++ " (c) 2002-today BNFC development team."
  , "Free software under GNU General Public License (GPL)."
  , "List of recent contributors at https://github.com/BNFC/bnfc/graphs/contributors."
  , "Report bugs at https://github.com/BNFC/bnfc/issues."
  , ""
  ]

-- oldContributors :: [String]
-- oldContributors =
--   [ "(c) Jonas Almström Duregård, Krasimir Angelov, Jean-Philippe Bernardy, Björn Bringert, Johan Broberg, Paul Callaghan, "
--   , "    Grégoire Détrez, Markus Forsberg, Ola Frid, Peter Gammie, Thomas Hallgren, Patrik Jansson, "
--   , "    Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, "
--   , "    Michael Pellauer and Aarne Ranta 2002 - 2013."
--   ]

usage :: String
usage = unlines
  [ "usage: bnfc [--TARGET] [OPTIONS] LANG.cf"
  , "   or: bnfc --[numeric-]version"
  , "   or: bnfc [--help]"
  ]

help :: String
help = unlines $ title ++
    [ usage
    , usageInfo "Global options"   globalOptions
    , usageInfo "Common options"   commonOptions
    , usageInfo "TARGET languages" targetOptions
    ] ++ map targetUsage helpTargets
  where
  helpTargets = [ TargetHaskell, TargetJava, TargetC, TargetCpp, TargetCSharp ]
  targetUsage t = usageInfo
    (printf "Special options for the %s backend" (show t))
    (specificOptions' t)

-- ~~~ Parsing machinery ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- | Main parsing function
parseMode :: [String] -> (Mode, UsageWarnings)
parseMode args =
  case runWriterT $ parseMode' =<< translateOldOptions args of
    Left err  -> (UsageError err, [])
    Right res -> res

type ParseOpt = WriterT UsageWarnings (Either String)
type UsageWarnings = [String]

parseMode' :: [String] -> ParseOpt Mode
parseMode' []   = return Help
parseMode' args =
  -- First, check for global options like --help or --version
  case getOpt' Permute globalOptions args of
   (mode:_,_,_,_) -> return mode

   -- Then, check for unrecognized options.
   _ -> do
    let (_, _, unknown, _) = getOpt' Permute allOptions args
    processUnknownOptions unknown

    -- Then, determine target language.
    case getOpt' Permute targetOptions args of
      -- ([]     ,_,_,_) -> usageError "No target selected"  -- --haskell is default target
      (_:_:_,_,_,_) -> usageError "At most one target is allowed"

      -- Finally, parse options with known target.
      (optionUpdates,_,_,_) -> do
        let tgt = target (options optionUpdates)
        case getOpt' Permute (allOptions' tgt) args of
          (_,  _, _,      e:_) -> usageError e
          (_,  _, [u],      _) -> usageError $ unwords $ [ "Backend", show tgt, "does not support option", u ]
          (_,  _, us@(_:_), _) -> usageError $ unwords $ [ "Backend", show tgt, "does not support options" ] ++ us
          (_, [], _,        _) -> usageError "Missing grammar file"
          (optionsUpdates, [grammarFile], [], []) -> do
            let opts = (options optionsUpdates)
                       { lbnfFile = grammarFile
                       , lang = takeBaseName grammarFile
                       }
            warnDeprecatedBackend tgt
            warnDeprecatedOptions opts
            return $ Target opts grammarFile
          (_,  _, _,        _) -> usageError "Too many arguments"
  where
  options optionsUpdates = foldl (.) id optionsUpdates defaultOptions
  usageError = return . UsageError


-- * Deprecation

class Maintained a where
  maintained   :: a -> Bool
  printFeature :: a -> String

instance Maintained Target where
  printFeature = printTargetOption
  maintained = \case
    TargetC           -> True
    TargetCpp         -> True
    TargetCppNoStl    -> True
    TargetCSharp      -> False
    TargetHaskell     -> True
    TargetHaskellGadt -> True
    TargetLatex       -> True
    TargetJava        -> True
    TargetOCaml       -> True
    TargetProfile     -> False
    TargetPygments    -> True
    TargetCheck       -> True

instance Maintained AlexVersion where
  printFeature = printAlexOption
  maintained = \case
    Alex1 -> False
    Alex2 -> False
    Alex3 -> True

instance Maintained HappyMode where
  printFeature = \case
    Standard -> undefined
    GLR      -> "--glr"
  maintained = \case
    Standard -> True
    GLR      -> False

warnDeprecatedBackend :: Maintained a => a -> ParseOpt ()
warnDeprecatedBackend backend =
  Ctrl.unless (maintained backend) $ warnDeprecated $ unwords [ "backend", printFeature backend ]

warnDeprecated :: String -> ParseOpt ()
warnDeprecated feature =
  tell
    [ unwords [ "Warning:", feature, "is deprecated and no longer maintained." ]
    -- , "Should it be broken, try an older version of BNFC."
    ]

warnDeprecatedOptions :: SharedOptions -> ParseOpt ()
warnDeprecatedOptions Options{..} = do
  warnDeprecatedBackend alexMode
  warnDeprecatedBackend glr
  Ctrl.when shareStrings $ warnDeprecated $ "feature --sharestrings"

-- * Backward compatibility

-- | Produce a warning for former options that are now obsolete.
--   Throw an error for properly unknown options.
--
--   Note: this only works properly for former options that had no arguments.
processUnknownOptions :: [String] -> ParseOpt ()
processUnknownOptions os = do
  case List.partition (`elem` obsoleteOptions) os of
    -- Throw an error for properly unknown options.
    (_, us@[_]  ) -> throwError $ unwords $ "Unrecognized option:"  : us
    (_, us@(_:_)) -> throwError $ unwords $ "Unrecognized options:" : us
    -- Generate warning for former options that are now obsolete.
    (os@[_]  , _) -> tell [ unwords $ "Warning: ignoring obsolete options:" : os ]
    (os@(_:_), _) -> tell [ unwords $ "Warning: ignoring obsolete options:" : os ]
    ([], []) -> return ()
  where
  obsoleteOptions = []

-- | A translation function to maintain backward compatibility
--   with the old option syntax.

translateOldOptions :: [String] -> ParseOpt [String]
translateOldOptions = mapM $ \ o -> do
   case Map.lookup o translation of
     Nothing -> return o
     Just o' -> do
       tell [ unwords [ "Warning: unrecognized option", o, "treated as if", o', "was provided." ] ]
       return o'
  where
  translation = Map.fromList $
    [ ("-agda"         , "--agda")
    , ("-java"         , "--java")
    , ("-java1.5"      , "--java")
    , ("-c"            , "--c")
    , ("-cpp"          , "--cpp")
    , ("-cpp_stl"      , "--cpp")
    , ("-cpp_no_stl"   , "--cpp-nostl")
    , ("-csharp"       , "--csharp")
    , ("-ocaml"        , "--ocaml")
    , ("-haskell"      , "--haskell")
    , ("-prof"         , "--profile")
    , ("-gadt"         , "--haskell-gadt")
    , ("-alex1"        , "--alex1")
    , ("-alex2"        , "--alex2")
    , ("-alex3"        , "--alex3")
    , ("-sharestrings" , "--sharestring")
    , ("-bytestrings"  , "--bytestring")
    , ("-glr"          , "--glr")
    , ("-xml"          , "--xml")
    , ("-xmlt"         , "--xmlt")
    , ("-vs"           , "--vs")
    , ("-wcf"          , "--wcf")
    , ("-generic"             , "--generic")
    , ("--ghc"                , "--generic")
    , ("--deriveGeneric"      , "--generic")
    , ("--deriveDataTypeable" , "--generic")
    ]
